WasPentalive [Ronald Hudson] 7th December 2022 at 8:57pm
' WasPentalive's Trek
Version$ = "1.0.0" ' Feature Complete (for now)
' Expecting only bugfixes unless new ideas come in
' Version$="0.3.41" Zounds! sounds!
' estabished failsound and goodsound subroutines
' goodsound for giving your ship a name, failsound for letting it default.
'
' Version$ = "0.3.40" Klingon Bases
' Klingons will build a base wherever 4 klingon ships are in one sector
' Phasors can not hurt a base. Photon Torpedos only kill a base 30% of the time
' Bases can build Klingon ships as needed to keep the population at 4
' one ship at a time
' - because of that you must kill the base first, then at least 1 klingon.
' - bases are placed in Buildasector
' - bases build klingon ships in MkStatus
' - btw Klingon bases can only happen where 4 klingons have killed a base
' because at most only 3 klingons in a sector unless there is a base
'
' BUG FIX - able to enter non integer coordinates in impulse
'
'
' Version$ = "0.3.36"
' Garbled message on phasor klingons destroyed - fixed
' fixed "fire phasors costs no energy" it should cost - a lot.
' Low energy warning
' Added Fan Based Disclaimer- and let player name the ship
' "0.3.35" ' per request add color alert status, remove "under attack" display
' also adding version display during universe build
' also added color to repair status
'"0.3.34"
' speeding up klingon attack reports'
'"0.3.33"
' swapping x and y in UI
' fix spelling error
' re-arrange warp arrival so LRS shows new ship location immidiatly
'
cls
print
print " ==================================="
print " A Nearly traditional Star Trek game"
print " ==================================="
print
print " This game is a STAR TREK FAN PRODUCTION: "
print
print " Star Trek and all related marks, logos and characters are solely owned "
print " by CBS Studios Inc. This fan production is not endorsed by, sponsored "
print " by, nor affiliated with CBS, Paramount Pictures, or any other Star Trek "
print " franchise, and is a non-commercial fan-made game intended for recreational"
print " use. No commercial distribution is permitted. No alleged independent "
print " rights will be asserted against CBS or Paramount Pictures."
Print
print "press any key when ready ";
gosub twirly
cls
Print
print "Gnu General Public License"
print
print "Trek or WasPentalive's Trek. A Nearly traditiona Star Trek Game"
print "Copyright (C) 2022 Ronald Hudson.
print
print "This program is free software: you can redistribute it and/or modify"
print "it under the terms of the GNU General Public License as published by"
print "the Free Software Foundation, either version 3 of the License, or"
print "(at your option) any later version."
print
print "This program is distributed in the hope that it will be useful,"
print "but WITHOUT ANY WARRANTY; without even the implied warranty of
print "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the"
print "GNU General Public License for more details.
print
print "You should have received a copy of the GNU General Public License"
print "along with this program. If not, see <https://www.gnu.org/licenses/>."
print
print "This licenses only applies to the Basic source code as prepeared for the "
print "Basic anywhere machine. "
print
print "The Basic Anywhere Machine has its own permissive license"
Print "======================================================================"
input "Please Name your Starship:";SN$
if sn$ = "" then
sn$ = "NX3105 Excalibur"
gosub failsound
else
gosub goodsound
end if
cls
OPTION BASE 0
RANDOMIZE TIMER
screen 8
COLOR 14, 0
CLS
DIM s(9, 9)
DIM q(9, 9, 4)
DIM devstat(8)
DIM devshort$(8)
DIM devname$(8)
srs = 1: devshort$(1) = "SRS": devname$(1) = "Short Range Sensors"
lrs = 2: devshort$(2) = "LRS": devname$(2) = "Long Range Sensors"
ida = 3: devshort$(3) = "IDA": devname$(3) = "Impulse Drive Assy"
wda = 4: devshort$(4) = "WDA": devname$(4) = "Warp Drive Assy"
pha = 5: devshort$(5) = "PHA": devname$(5) = "Phaser Banks"
pho = 6: devshort$(6) = "PHO": devname$(6) = "Photon Torpedo Launcher"
shg = 7: devshort$(7) = "SHG": devname$(7) = "Shield Generator"
cmp = 8: devshort$(8) = "CMP": devname$(8) = "Library Computer"
aEmpty = 0
astar = 1
abase = 2
aklingon = 3
aStarship = 4
aPhotorp = 5
aKbase = 6
coward = 0
kbase = 0
dmg$ = ""
gosub BuildSectors
tp = 10
eng = 3000
dz = INT(klingons * 400 / bases)
esx = INT(RND(1) * 8) + 1
esy = INT(RND(1) * 8) + 1
eqx = INT(RND(1) * 8) + 1
eqy = INT(RND(1) * 8) + 1
dmg$ = "Ship Initial Location (" + eqy + "." + esy + "," + eqx + "." + esx + ") "
CLS
print "WasPentalive's Trek Version:";version$
gosub orders
gosub twirly
FOR I = 1 TO 8: devstat(I) = 99: NEXT I
alive = 1
gosub buildasector
CLS
DO
cls
gosub mkstatus
gosub display
gosub command
IF alive THEN gosub kattack
gosub eogtest
LOOP WHILE alive
END
buildasector:
FOR x = 1 TO 8
FOR y = 1 TO 8
s(x, y) = 0
NEXT y
NEXT x
s(esx, esy) = 4
kbase = 0
if q(eqx,eqy,aklingon) > 3 and q(eqx,eqy,abase) = 0 then
kbase = 1
kbx = int(rnd(1)*8)+1
kby = int(rnd(1)*8)+1
s(kbx,kby) = akbase
end if
FOR t = 1 TO 3
FOR e = 1 TO q(eqx, eqy, t)
DO
x = INT(RND(1) * 8) + 1
y = INT(RND(1) * 8) + 1
LOOP while s(x, y) > 0
s(x, y) = t
NEXT e
NEXT t
return
BuildSectors:
bases = 0
klingons = 0
FOR x = 1 TO 8
FOR y = 1 TO 8
st = INT(RND(1) * 6) + 1
IF st > 4 THEN st = 4
ba = INT(RND(1) * 3)
IF ba > 1 THEN ba = 0
kl = INT(RND(1) * 4) + ba
q(x, y, astar) = st
q(x, y, abase) = ba
q(x, y, aklingon) = kl
q(x, y, astarship) = 0
bases = bases + ba
klingons = klingons + kl
NEXT y
NEXT x
' record original numbers of these
zbase = bases
zklin = klingons
return
command:
PRINT "Command [PTRWIQ?] :"
DO
a$ = INKEY$
LOOP WHILE a$ = ""
a$ = UCASE$(a$)
SELECT CASE a$
CASE "P"
gosub phasor
CASE "T"
gosub photorp
CASE "R"
FOR I = 1 TO 8
IF devstat(I) < 99 THEN
r = INT(RND(1) * 5)
devstat(I) = devstat(I) + r
IF devstat(I) > 99 THEN devstat(I) = 99
END IF
NEXT I
dz = dz - 1
eng = eng + INT(RND(1) * 30)
dmg$ = "Spent one day repairing systems"
CASE "W"
gosub warpdrive
CASE "I"
gosub Impulse
CASE "Q"
coward = 1
alive = 0
CASE "="
input "device :";dev
input "repair :";rep
devstat(dev) = rep
CASE "-"
dmg$ = "Q zaps all the klingons here for you, but it cost you days"
klingons = klingons - q(eqx, eqy, aklingon)
days = days - q(eqx, eqy, aklingon)
q(eqx, eqy, aklingon) = 0
gosub buildasector
CASE "?"
CLS
PRINT "+------------------+------------------------------------------+"
PRINT "| T Photon Torpedo | Kills one target very dead |"
PRINT "| P Phasors | Kills all targets, takes a lot of energy |"
PRINT "| W Warp Drive | Travel to other sectors |"
PRINT "| I Impulse Drive | Travel within this sector |"
PRINT "| R Repair | Take a day for repair |"
PRINT "| ? Help | Print this list |"
PRINT "| Q Quit | End Simulation |"
PRINT "+------------------+------------------------------------------+"
PRINT
gosub orders
gosub twirly
CLS
CASE ELSE
dmg$ = "Directive " + a$ + " is not recognised. please re-state"
END SELECT
return
mkstatus:
stat$ = "GREEN "
FOR disx = -1 TO 1
FOR disy = -1 TO 1
q(eqx + disx, eqy + disy, 4) = 1
IF s(esx + disx, esy + disy) = abase THEN stat$ = "DOCKED"
NEXT disy
NEXT disx
IF q(eqx, eqy, aklingon) > 0 THEN stat$ = "RED"
if kbase = 1 then stat$ = "BLACK"
IF stat$ = "DOCKED" THEN
dmg$ = "Starbase replenish and Repair"
disppause = 1
tp = 10
eng = 3000
' starbase repairs
FOR disI = 1 TO 8
IF devstat(disI) < 99 THEN
devstat(disI) = (devstat(disI) + INT(RND(1) * 10))
if devstat(disI) > 99 then devstat(disI) = 99
END IF
NEXT disI
END IF
return
display:
cls
COLOR 14, 0
locate 1,1
PRINT SN$;" ("; eqy; "."; esy; ","; eqx; "."; esx; ") "
PRINT "Days:"; dz; " Energy:"; eng; " Photorp:"; tp;
PRINT " Status:";
if stat$="DOCKED" then color 9
if stat$="RED" then color 12
if stat$="GREEN " then color 10
if stat$="BLACK" then color 0,1
Print stat$;
color 14,0
PRINT " SBK Bases:"; bases; " Klingons:"; klingons
PRINT " ========================================================================"
PRINT " 1 2 3 4 5 6 7 8 DEV %% 1 2 3 4 5 6 7 8"
PRINT " ========================================================================"
FOR disx = 1 TO 8
PRINT RIGHT$(STR$(disx), 1); "|";
FOR disy = 1 TO 8
IF disx = esx AND disy = esy THEN PRINT "["; ELSE PRINT " ";
IF devstat(srs) < INT(RND(1) * 99) THEN
PRINT "@";
ELSE
select case s(disx,disy)
case aempty
color 14,0
print ".";
case astar
color 14,0
print "*";
case aklingon
color 12,0
print "-";
case abase
color 10,0
print "#";
case astarship
color 10,0
print "+";
case aPhotorp
color 9,0
print "!";
case akbase
color 0,1
print "=";
case else
color 0,15
print "?";
end select
color 14,0
END IF
IF disx = esx AND disy = esy THEN PRINT "]"; ELSE PRINT " ";
NEXT disy
color 14,0
PRINT "|";
if devstat(disx) <= 98 then color 11,0
if devstat(disx) <= 70 then color 13,0
if devstat(disx) <= 40 then color 15,0
if devstat(disx) <= 20 then color 12,0
if devstat(disx) <= 10 then color 12,3
PRINT devshort$(disx); ":"; RIGHT$("00" + STR$(devstat(disx)), 2);
color 14,0
Print "|";
FOR disy = 1 TO 8
n$ = "???"
IF devstat(lrs) < INT(RND(1) * 99) or devstat(cmp) < int(rnd(1)*99) THEN
n$ = "=@="
ELSE
IF q(disx, disy, 4) = 0 THEN
n$ = "..."
ELSE
n$ = ""
n$ = n$ + RIGHT$(STR$(q(disx, disy, astar)), 1)
n$ = n$ + RIGHT$(STR$(q(disx, disy, abase)), 1)
n$ = n$ + RIGHT$(STR$(q(disx, disy, aklingon)), 1)
END IF
END IF
IF eqx = disx AND eqy = disy THEN PRINT "["; ELSE PRINT " ";
COLOR 14, 0
IF q(disx, disy, abase) > 0 THEN COLOR 9, 0
IF q(disx, disy, aklingon) > 0 THEN COLOR 4, 0
if q(disx, disy, aklingon) >0 and q(disx,disy,abase)> 0 then color 4,2
IF q(disx, disy, 4) = 0 THEN COLOR 14, 0
if q(disx, disy, aklingon) = 4 and q(disx,disy,abase) = 0 then color 0,1
PRINT n$;
COLOR 14, 0
IF eqx = disx AND eqy = disy THEN PRINT "]"; ELSE PRINT " ";
NEXT disy
PRINT right$(" "+str$(disx),2)
NEXT disx
PRINT " ========================================================================"
PRINT " 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8"
PRINT " ========================================================================"
PRINT dmg$
dmg$ = ""
return
eogtest:
' end of game testing
if eng < 80 then
dmg$ = "WARNING: Energy reserves are critially low "
cls
gosub display
gosub twirly
end if
' did computer system fail due to damage - forgets everything
if devstat(cmp) < int(rnd(1)*99) then
for cmpx = 1 to 8
for cmpy = 1 to 8
q(cmpx,cmpy,4) = 0
next cmpy
next cmpx
dmg$ = "Ship's computer has failed due to battle damage, memory erased"
gosub failsound
cls
gosub display
gosub twirly
end if
' Did we cut and run?
if coward = 1 then
cls
gosub failsound
print "You have departed your patrol area with ";klingons;" combantants "
print "remaining. On hearing of your dishonorable action the entire "
print "Klingon force remaining has now left for EARTH "
print "You might as well head off to the Delta quadrant because "
print "if there is a Federation left, you will be executed and court martialed"
sleep .5
end
end if
' did we run out of energy?
IF eng < 50 THEN
alive = 0
gosub failsound
PRINT "Your ship is so low on energy that only life support "
PRINT "works. You are drifting, uncontrolled, waiting for "
PRINT "rescue from the nearest ... "
PRINT "Klingon"
ELSE
' have we eliminated the klingon menace?
IF klingons = 0 THEN
alive = 0
sound 300,10
sound 400,20
sound 200,10
sound 500,20
PRINT "You have destroyed every last invading Klingon! Earth is safe "
PRINT "You and your crew are heros. Next stop -Risa! "
ELSE
' Have we run out of time?
IF dz = 0 THEN
alive = 0
gosub failsound
PRINT "Time is up. "; klingons; " Klingon warships are "
PRINT "now headed for earth. They will take up the "
PRINT "battle in sector 001"
END IF
END IF
END IF
return
Impulse:
IF devstat(ida) < INT(RND(1) * 99) THEN
dmg$ = "Impulse Drive is Offline"
gosub failsound
ELSE
INPUT "Specify in sector destination x,y :"; y, x
if x<>int(x) or y<>int(y) then
dmg$="Ignoring non-integer portion of the cordinates"
x = int(x)
y = int(y)
cls
gosub display
sleep .5
end if
if x>8 or x<1 or y>8 or y<1 then
dmg$ = "Improper coordinates specified "
gosub failsound
else
IF s(x, y) <> 0 THEN
dmg$ = "Navigation inhibited, destination occupied"
gosub failsound
ELSE
IF eng < 50 THEN
dmg$ = "Not enough energy for impulse transit"
gosub failsound
ELSE
s(esx, esy) = 0
esx = x
esy = y
s(x, y) = 4
eng = eng - 50
dmg$ = "Transit Completed"
gosub goodsound
END IF
END IF
END IF
END IF
cls
gosub display
gosub twirly
return
kattack:
cls
FOR x = 1 TO 8
FOR y = 1 TO 8
IF eqx = x AND eqy = y THEN
FOR x1 = 1 TO 8
FOR y1 = 1 TO 8
IF s(x1, y1) = aklingon THEN
dm = INT(RND(1) * 8)
sy = INT(RND(1) * 8)
IF devstat(shg) => INT(RND(1) * 99) THEN sy = shg
if dm > devstat(sy) then dm = devstat(sy)
devstat(sy) = devstat(sy) - dm
dmg$= "Hit to "+devname$(sy)+", "+devstat(sy)+" remains"
cls
gosub display
sleep .5
END IF
NEXT y1
NEXT x1
ELSE
IF q(x, y, abase) > 0 AND q(x, y, aklingon) > 0 THEN
IF INT(RND(1) * 99) < 5 THEN
q(x, y, abase) = q(x, y, abase) - 1
bases = bases - 1
dmg$ = "Starbase " + y + x + " is under attack"
dmg$ = dmg$+", and was destroyed"
cls
gosub display
sleep 1
END IF
q(x,y,4) = 1
END IF
end if
NEXT y
NEXT x
return
orders:
PRINT " "
PRINT " Current SitRep: "
PRINT " ===================================================="
PRINT " Current Location "
PRINT " Sector ("; eqy;","; eqx; ")"
PRINT " System ("; esy;","; esx; ")"
print " Energy :";eng;" Photorp Available:";tp
PRINT " ===================================================="
PRINT " You have "; bases; " bases for repair and resupply"
PRINT " The Klingon invasion force numbers "; klingons;" warships"
PRINT " We estimate they will begin the attack on earth "
PRINT " in "; dz; " days"
PRINT " ===================================================="
PRINT "Original bases:";zbase;" Starting Klingons:",zklin
return
phasor:
if kbase then
dmg$ = "Phasors are inhibited by a field generated by the klingon base"
gosub failsound
cls
gosub display
gosub twirly
return
end if
IF devstat(pha) < INT(RND(1) * 99) THEN
dmg$ = "Phasors offline "
gosub failsound
ELSE
IF q(eqx, eqy, aklingon) = 0 THEN
dmg$ = "No valid targets in sector"
gosub failsound
ELSE
DO
INPUT "Phasor bank charge percentage: (0 to 99) :"; chg
LOOP WHILE chg > 99 OR chg < 0
IF chg * 10 > eng THEN
dmg$ = "Not enough energy to charge to that level"
gosub failsound
ELSE
cls
gosub display
kills = 0
eng = eng - (10 * chg)
for phax = 1 to 8
for phay = 1 to 8
if s(phax,phay) = aklingon then
if int(rnd(1)*99) < chg then
s(phax,phay) = aempty
klingons = klingons - 1
dmg$ = "Klingon at "+phay+","+phax+" Destroyed "
kills = kills + 1
q(eqx,eqy,aklingon) = q(eqx,eqy,aklingon) - 1
else
dmg$ = "Klingon at "+ phay + phax + " Remains "
end if
cls
gosub display
sleep .5
end if
next phay
next phax
dz = dz - 1
drem = q(eqx,eqy,aklingon)
dmg$ = kills + " Klingons destroyed " + drem + " remain. "
gosub goodsound
END IF
END IF
END IF
cls
gosub display
gosub twirly
if chg > 85 then
dmg$ = "Warning : Charging phasors over 85% can cause damage"
cls
gosub display
sleep 1
if int(rnd(1)*99) < 50 or chg > 90 then
dmg$="High charge to phasors has casused damage"
gosub failsound
cls
gosub display
sleep 1
devstat(pha) = devstat(pha) - int(rnd(1)*20)+1
if devstat(pha) < 0 then devstat(pha) = 1
end if
end if
return
photorp:
IF devstat(pho) < INT(RND(1) * 99) THEN
dmg$ = "Torpedo Launcher offline"
gosub failsound
ELSE
IF tp = 0 THEN
dmg$ = "No Photon Torpedos"
gosub failsound
ELSE
INPUT "Specify Target x,y :"; qy, qx
IF s(qx, qy) <> aklingon and s(qx,qy) <> akbase THEN
dmg$ = "Launch inhibit - target is not a hostile"
gosub failsound
ELSE
tp = tp - 1
tx = esx
ty = esy
CLS
DO
' move the torpedo
IF tx > qx THEN tx = tx - 1
IF tx < qx THEN tx = tx + 1
IF ty > qy THEN ty = ty - 1
IF ty < qy THEN ty = ty + 1
' and flash its new position
if s(tx,ty) = aempty then
s(tx,ty) = aPhotorp
gosub display
sleep .5
s(tx,ty) = aEmpty
end if
LOOP WHILE s(tx, ty) = 0
if s(tx,ty) = akbase then
if int(rnd(1)*99) <= 30 then
dmg$="The klingon base was destroyed"
s(tx,ty) = aempty
kbase = 0
gosub goodsound
else
dmg$="The klingon base takes damage "
gosub failsound
end if
gosub display
gosub twirly
return
end if
IF s(tx, ty) = aklingon THEN
s(tx, ty) = aempty
klingons = klingons - 1
q(eqx, eqy, aklingon) = q(eqx, eqy, aklingon) - 1
dmg$ = "Klingon at" + STR$(tx) + "," + STR$(ty) + " Destroyed"
if kbase then
dmg$ = "Klingon at" + STR$(tx) + "," + STR$(ty)
dmg$ = dmg$ + " replaced by the klingon base"
q(eqx,eqy,aklingon) = q(eqx,eqy,aklingon) + 1
s(tx,ty) = aklingon
klingons = klingons + 1
gosub failsound
else
gosub goodsound
end if
END IF
IF s(tx, ty) = astar THEN
dmg$ = "The star burps"
END IF
IF s(tx, ty) = abase THEN
dmg$ = "That was OUR base, You destroyed our starbase"
gosub failsound
s(tx, ty) = aempty
bases = bases - 1
q(eqx, eqy, abase) = q(eqx, eqy, abase) - 1
END IF
cls
gosub display
gosub twirly
END IF
END IF
END IF
return
twirly:
sound 440,20
c$ = "+-+-"
row = CSRLIN
col = POS(0)
slant = 0
DO
LOCATE row, col
PRINT MID$(c$, slant + 1 MOD 4, 1);
slant = (slant + 1) MOD 4
SLEEP 0.06
k$ = inkey$
LOOP while k$=""
locate row,col
print " ";
return
warpdrive:
IF devstat(wda) < INT(RND(1) * 100) THEN
dmg$ = "Warp drive is offline"
ELSE
do
INPUT "Specify Destination Quadrant x,y :"; y, x
x = int(x)
y = int(y)
loop while x>8 or x<1 or y>8 or y<1
d = ABS(eqx - x) + ABS(equ - y)
IF d * 30 > eng THEN
dmg$ = "Energy available is insufficient for warp transit"
gosub failsound
ELSE
eng = eng - d * 30
dz = dz - d
eqx = x
eqy = y
esx = INT(RND(1) * 8 + 1)
esy = INT(RND(1) * 8 + 1)
gosub buildasector
dmg$ = "Record Ship Arrival"
gosub goodsound
END IF
END IF
cls
gosub mkstatus
gosub display
gosub twirly
return
failsound:
sound 500,5
sound 200,10
sleep .5
return
goodsound:
sound 200,10
sound 200,5
sound 500,10
sleep .5
return